﻿Imports System.Runtime.CompilerServices
Imports System.Threading
Imports System.Runtime.InteropServices

Public Class ThisAddIn

    Private WithEvents DeleteTimer As System.Timers.Timer

    Friend Shared FolderValues As RegistryStoredFolderValuesCollection

    Dim DeleteFinish As New AutoResetEvent(False)
    Dim index As Integer

    Private Sub ThisAddIn_Startup() Handles Me.Startup
        AddHandler CType(Application, Outlook.ApplicationEvents_11_Event).OptionsPagesAdd, AddressOf AddOptionsPage
        DeleteTimer = New System.Timers.Timer(3600000D)
        DeleteTimer.AutoReset = False
        AddHandler DeleteTimer.Elapsed, AddressOf DeleteTimer_Elapsed
        DeleteTimer.Start()
        If FolderValues Is Nothing Then FolderValues = New RegistryStoredFolderValuesCollection()
    End Sub

    Private Sub ThisAddIn_Shutdown() Handles Me.Shutdown
        DeleteTimer.Stop()
        DeleteTimer.Dispose()
    End Sub

    Private Sub DeleteTimer_Elapsed(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs)
        Dim Folder As Outlook.Folder
        Dim delcount As Integer = 0
        'Dim StartIndex As Integer
        For Each f As RegistryStoredFolderValues In FolderValues
            If f.Disabled Then Continue For
            Try
                Folder = GetFolderByPath(f.FolderPath)
                If Folder Is Nothing Then
                    If MsgBox("The folder " & f.FolderPath & " cannot be found. Would you like to disable email deletions on it?", _
                           MsgBoxStyle.Question Or MsgBoxStyle.YesNo, "Email Delete Error") = MsgBoxResult.Yes Then
                        f.Disabled = True
                        FolderValues.Replace(f)
                    End If
                    Continue For
                End If
                'StartIndex = If(f.CurrentIndex < 0, 0, f.CurrentIndex)
                Folder.DeleteBefore(f.OldestValidDate)
                'index = StartIndex
                Marshal.ReleaseComObject(Folder)
                Folder = Nothing
            Catch ex As Exception
                MsgBox("An error occurred while deleting emails." & vbCrLf & vbCrLf & ex.ToString(), _
                       MsgBoxStyle.Critical Or MsgBoxStyle.OkOnly, "Email Delete Error")
                If Folder IsNot Nothing Then Marshal.ReleaseComObject(Folder)
            End Try
            'DeleteThread = New Thread(AddressOf DeleteMessages)
            'DeleteThread.Start(f)
            'DeleteFinish.WaitOne()
            'f.CurrentIndex = index
        Next
        'If (From x As RegistryStoredFolderValues In FolderValues Where x.CurrentIndex > 0).Count() > 0 Then
        '    DeleteTimer.Interval = 60000D
        'Else
        '    DeleteTimer.Interval = 60000D '3600000D
        '    For Each f As RegistryStoredFolderValues In FolderValues
        '        If Not f.Disabled Then f.CurrentIndex = -1
        '    Next
        'End If
        DeleteTimer.Start()
    End Sub

    'Private Sub DeleteMessages(ByVal f As RegistryStoredFolderValues)
    '    Dim Folder As Outlook.Folder
    '    Dim delcount As Integer = 0
    '    Dim StartIndex As Integer
    '    Try
    '        Folder = GetFolderByPath(f.FolderPath)
    '        If Folder Is Nothing Then
    '            If MsgBox("The folder " & f.FolderPath & " cannot be found. Would you like to disable email deletions on it?", _
    '                   MsgBoxStyle.Question Or MsgBoxStyle.YesNo, "Email Delete Error") = MsgBoxResult.Yes Then
    '                f.Disabled = True
    '                FolderValues.Replace(f)
    '            End If
    '            Exit Sub
    '        End If
    '        StartIndex = If(f.CurrentIndex < 0, 0, f.CurrentIndex)
    '        Folder.DeleteBefore(f.OldestValidDate, StartIndex)
    '        index = StartIndex
    '    Catch ex As Exception
    '        MsgBox("An error occurred while deleting emails." & vbCrLf & vbCrLf & ex.ToString(), _
    '               MsgBoxStyle.Critical Or MsgBoxStyle.OkOnly, "Email Delete Error")
    '    End Try
    '    DeleteFinish.Set()
    'End Sub

    Friend Shared Function GetFolderByPath(ByVal FolderPath As String) As Outlook.Folder
        Dim Folder As Outlook.Folder = Nothing, Folder2 As Outlook.Folder = Nothing
        Dim FoldersArray As String()

        Try
            If FolderPath.StartsWith("\\") Then FolderPath = FolderPath.Substring(2)
            FoldersArray = Split(FolderPath, "\")

            For Each f As String In FoldersArray
                Folder2 = If(Folder, New Outlook.Application().Session).Folders(f)
                If Folder2 Is Nothing Then Return Nothing
                If Folder IsNot Nothing Then Marshal.ReleaseComObject(Folder)
                Folder = Folder2
                Folder2 = Nothing
            Next
            Return Folder
        Catch e As Exception
            Return Nothing
        End Try
    End Function

    Private Sub AddOptionsPage(ByVal Pages As Outlook.PropertyPages)
        Pages.Add(New DeleteOptionsPage(), "Delete Emails")
    End Sub

End Class

Public Module Extensions

    <Extension()> _
    Public Sub PermanentlyDelete(ByVal Item As Outlook.MailItem)
        Item.Session.GetItemFromID(Item.EntryID, Item.Parent.StoreId).Delete()
    End Sub

    <Extension()> _
    Public Sub PermanentlyDelete(ByVal Item As Outlook.MeetingItem)
        Item.Session.GetItemFromID(Item.EntryID, Item.Parent.StoreId).Delete()
    End Sub

    ''' <summary>
    ''' Permanently deletes all messages received before the given date.
    ''' </summary>
    ''' <param name="Folder"></param>
    ''' <param name="OldestValidDate">The oldest date that should remain after the deletion</param>
    ''' <remarks></remarks>
    <Extension()> _
    Public Function DeleteBefore(ByVal Folder As Outlook.Folder, ByVal OldestValidDate As Date) As Integer
        Dim delcount As Integer = 0
        Dim Items As Outlook.Items = Folder.Items
        Dim Item As Object
        For i As Integer = Items.Count() To 1 Step -1
            Item = Items(i)
            Select Case True
                Case TypeOf Item Is Outlook.MailItem AndAlso _
                        DirectCast(Item, Outlook.MailItem).ReceivedTime < OldestValidDate
                    DirectCast(Item, Outlook.MailItem).PermanentlyDelete()
                    delcount += 1
                Case TypeOf Item Is Outlook.MeetingItem AndAlso _
                            DirectCast(Item, Outlook.MeetingItem).ReceivedTime < OldestValidDate
                    DirectCast(Item, Outlook.MeetingItem).PermanentlyDelete()
                    delcount += 1
            End Select
            Marshal.ReleaseComObject(Item)
            Item = Nothing
        Next
        Return delcount
        Marshal.ReleaseComObject(Items)
    End Function

    ' ''' <summary>
    ' ''' Permanently deletes all messages received before the given date.
    ' ''' </summary>
    ' ''' <param name="Folder"></param>
    ' ''' <param name="OldestValidDate">The oldest date that should remain after the deletion</param>
    ' ''' <remarks></remarks>
    '<Extension()> _
    'Public Function DeleteBefore(ByVal Folder As Outlook.Folder, ByVal OldestValidDate As Date) As Integer
    '    Dim oItems As New List(Of Object)((From x As Object In Folder.Items
    '                                       Where (TypeOf x Is Outlook.MailItem AndAlso _
    '                                              CType(x, Outlook.MailItem).ReceivedTime < OldestValidDate) _
    '                                       OrElse (TypeOf x Is Outlook.MeetingItem AndAlso _
    '                                               CType(x, Outlook.MeetingItem).ReceivedTime < OldestValidDate)))
    '    Dim delcount As Integer = 0
    '    For Each i As Object In oItems
    '        If TypeOf i Is Outlook.MailItem Then
    '            CType(i, Outlook.MailItem).PermanentlyDelete()
    '            delcount += 1
    '        End If
    '        If TypeOf i Is Outlook.MeetingItem Then
    '            CType(i, Outlook.MeetingItem).PermanentlyDelete()
    '            delcount += 1
    '        End If
    '        Thread.Sleep(0)
    '    Next
    '    oItems.Clear()
    '    Return delcount
    'End Function

End Module